Proyecto de Contingencias de Vida I

Variacion Interanual

Tasa básica pasiva

### Poblaciones #### Tasas de mortalidad

Empleados de la empresa ABC

Punto A

  tablas_activos <- proyeccion_demografica_activos(base_empleados, tablas_supen)

llamamos es script con los gráficos.

source('code/graficos_activos.R')

fig_activos_vivos

Punto B

Punto C

fig_activos_muertos

Punto D

Punto E

Para esta sección, se toman las proyecciones demográficas ya hechas anteriormente.

En primer lugar, creamos las tablas en cuestión que nos ayudarán a graficar.

tablas_proy_fin <- proyeccion_financiera(tablas_activos, inflacion =  0.03)

Punto F

Punto G

Punto H

Estas son las primas para cada empleado tasa tomando en cuenta la inflación por medio de la ecuación de Fisher (1+i) = (1+tasa_real)(1+inflación), en este caso 0.0712 utilizando 0.04 tasa real y 0.03 de la inflación.

#Primas para empleados 
Primas<-Calcula_prima_individuales(base_empleados,tablas_supen,5000000,1000000,300000,0.04)

#Base de empleados de combinaciones únicas 
base_unicas<- unico(base_empleados)

#Primas para empleados, Hombre o Mujer y su respectiva edad 
Primas_unicas <- Calcula_prima_individuales(base_unicas,tablas_supen,5000000,1000000,300000,0.04)
Primas_unicas <- Primas_unicas%>%
                  mutate(Sexo = if_else(Sexo == 1,'Hombre', 'Mujer')) %>%
                  select(-c(`Empleado`,`anualidad`,`beneficios`))

tabla_latex_primas_unicas <- xtable(Primas_unicas)

print(tabla_latex_primas_unicas)

## % latex table generated in R 4.3.1 by xtable 1.8-4 package
## % Fri Jun 28 11:19:31 2024
## \begin{table}[ht]
## \centering
## \begin{tabular}{rlrr}
##   \hline
##  & Sexo & Edad & Primas \\ 
##   \hline
## 1 & Hombre & 20.00 & 439746.01 \\ 
##   2 & Hombre & 21.00 & 460165.70 \\ 
##   3 & Hombre & 22.00 & 481722.66 \\ 
##   4 & Hombre & 23.00 & 504503.70 \\ 
##   5 & Hombre & 24.00 & 528604.14 \\ 
##   6 & Hombre & 25.00 & 554129.76 \\ 
##   7 & Hombre & 26.00 & 581194.49 \\ 
##   8 & Hombre & 27.00 & 609924.77 \\ 
##   9 & Hombre & 28.00 & 640459.67 \\ 
##   10 & Hombre & 29.00 & 672952.45 \\ 
##   11 & Hombre & 30.00 & 707572.59 \\ 
##   12 & Hombre & 31.00 & 744512.41 \\ 
##   13 & Hombre & 32.00 & 783989.37 \\ 
##   14 & Hombre & 33.00 & 826247.54 \\ 
##   15 & Hombre & 34.00 & 871563.22 \\ 
##   16 & Hombre & 35.00 & 920250.24 \\ 
##   17 & Hombre & 36.00 & 972667.07 \\ 
##   18 & Hombre & 37.00 & 1029221.23 \\ 
##   19 & Hombre & 38.00 & 1090378.22 \\ 
##   20 & Hombre & 39.00 & 1156675.52 \\ 
##   21 & Hombre & 40.00 & 1228737.32 \\ 
##   22 & Hombre & 41.00 & 1307292.57 \\ 
##   23 & Hombre & 42.00 & 1393194.79 \\ 
##   24 & Hombre & 43.00 & 1487455.02 \\ 
##   25 & Hombre & 44.00 & 1591280.06 \\ 
##   26 & Hombre & 45.00 & 1706128.66 \\ 
##   27 & Hombre & 46.00 & 1833768.18 \\ 
##   28 & Hombre & 47.00 & 1976355.93 \\ 
##   29 & Hombre & 48.00 & 2136550.43 \\ 
##   30 & Hombre & 49.00 & 2317675.08 \\ 
##   31 & Hombre & 50.00 & 2523944.61 \\ 
##   32 & Hombre & 51.00 & 2760777.85 \\ 
##   33 & Hombre & 52.00 & 3035262.32 \\ 
##   34 & Hombre & 53.00 & 3356850.75 \\ 
##   35 & Hombre & 54.00 & 3738455.91 \\ 
##   36 & Hombre & 55.00 & 4198172.22 \\ 
##   37 & Hombre & 56.00 & 4762137.09 \\ 
##   38 & Hombre & 57.00 & 5469570.35 \\ 
##   39 & Hombre & 58.00 & 6382114.54 \\ 
##   40 & Hombre & 59.00 & 7602507.85 \\ 
##   41 & Hombre & 60.00 & 9315658.31 \\ 
##   42 & Hombre & 61.00 & 11891327.80 \\ 
##   43 & Hombre & 62.00 & 16192301.42 \\ 
##   44 & Hombre & 63.00 & 24807020.34 \\ 
##   45 & Hombre & 64.00 & 50677961.59 \\ 
##   46 & Mujer & 20.00 & 496285.77 \\ 
##   47 & Mujer & 21.00 & 519408.02 \\ 
##   48 & Mujer & 22.00 & 543822.12 \\ 
##   49 & Mujer & 23.00 & 569623.77 \\ 
##   50 & Mujer & 24.00 & 596919.38 \\ 
##   51 & Mujer & 25.00 & 625824.01 \\ 
##   52 & Mujer & 26.00 & 656463.19 \\ 
##   53 & Mujer & 27.00 & 688974.23 \\ 
##   54 & Mujer & 28.00 & 723510.65 \\ 
##   55 & Mujer & 29.00 & 760245.36 \\ 
##   56 & Mujer & 30.00 & 799370.48 \\ 
##   57 & Mujer & 31.00 & 841099.99 \\ 
##   58 & Mujer & 32.00 & 885673.90 \\ 
##   59 & Mujer & 33.00 & 933360.07 \\ 
##   60 & Mujer & 34.00 & 984463.48 \\ 
##   61 & Mujer & 35.00 & 1039330.44 \\ 
##   62 & Mujer & 36.00 & 1098355.06 \\ 
##   63 & Mujer & 37.00 & 1161986.50 \\ 
##   64 & Mujer & 38.00 & 1230740.17 \\ 
##   65 & Mujer & 39.00 & 1305213.10 \\ 
##   66 & Mujer & 40.00 & 1386098.81 \\ 
##   67 & Mujer & 41.00 & 1474206.18 \\ 
##   68 & Mujer & 42.00 & 1570484.16 \\ 
##   69 & Mujer & 43.00 & 1676054.27 \\ 
##   70 & Mujer & 44.00 & 1792255.21 \\ 
##   71 & Mujer & 45.00 & 1920691.61 \\ 
##   72 & Mujer & 46.00 & 2063303.92 \\ 
##   73 & Mujer & 47.00 & 2222464.50 \\ 
##   74 & Mujer & 48.00 & 2401105.72 \\ 
##   75 & Mujer & 49.00 & 2602900.21 \\ 
##   76 & Mujer & 50.00 & 2832501.60 \\ 
##   77 & Mujer & 51.00 & 3095891.78 \\ 
##   78 & Mujer & 52.00 & 3400890.07 \\ 
##   79 & Mujer & 53.00 & 3757928.28 \\ 
##   80 & Mujer & 54.00 & 4181238.06 \\ 
##   81 & Mujer & 55.00 & 4690749.52 \\ 
##   82 & Mujer & 56.00 & 5315242.83 \\ 
##   83 & Mujer & 57.00 & 6097887.75 \\ 
##   84 & Mujer & 58.00 & 7106531.13 \\ 
##   85 & Mujer & 59.00 & 8454276.51 \\ 
##   86 & Mujer & 60.00 & 10344737.13 \\ 
##   87 & Mujer & 61.00 & 13185153.76 \\ 
##   88 & Mujer & 62.00 & 17925803.78 \\ 
##   89 & Mujer & 63.00 & 27417626.59 \\ 
##   90 & Mujer & 64.00 & 55915485.82 \\ 
##    \hline
## \end{tabular}
## \end{table}

Punto I

Para la prima nivelada, se toman la suma de las esperanzas de los beneficios futuros y se divide por la suma de las esperanza del valor presente de las primas futuras, dando como resultado la prima nivelada anual.

## [1] 1228666

Punto J

Dado que la idea de este ejercicio es reducir las primas un 10%, calculo cuál es la suma que representa el 90% de las primas originales, para acercarnos a ellas.

#Calcula cuánto es el 90% de las primas obtenidas
Primas_90_porciento <- data.frame(Empleado = Primas$Empleado,
                                  Menos_10_porciento = (Primas$Primas)*0.9)

La primera alternativa para reducir la prima 10%:

# Se calculan primas con:
# Suma asegurada de 5 millones durante el tiempo de ser empleado activo
# Suma asegurada de 5 millones durante pensión 
# Primer año de pensión con mensualidad de 266.520 colones
Primas1_menos_10 <- Calcula_prima_individuales(base_empleados,tablas_supen,5000000,5000000,266520,0.04)

#se usa regla de 3 para verificar que la nueva prima sea aproximadamente el 90% de la original
Verifica1_90_porciento = data.frame(original_90 = Primas_90_porciento$Menos_10_porciento, 
                                    editada = Primas1_menos_10$Primas, 
                                    porcentaje= (Primas1_menos_10$Primas / Primas$Primas) * 100)

#Imprime el porcentaje promedio que representan las nuevas primas de las originales
print(sum(Verifica1_90_porciento$porcentaje)/nrow(Verifica1_90_porciento))

## [1] 90.08394

La Segunda alternativa para reducir la prima 10%:

# Se calculan primas con:
# Suma asegurada de 1 millón durante el tiempo de ser empleado activo
# Suma asegurada de 1 millón durante pensión 
# Primer año de pensión con mensualidad de 271.900 colones
Primas2_menos_10 <- Calcula_prima_individuales(base_empleados,tablas_supen,1000000,1000000,271900,0.04)

#se usa regla de 3 para verificar que la nueva prima sea aproximadamente el 90% de la original
Verifica2_90_porciento = data.frame(original_90 = Primas_90_porciento$Menos_10_porciento, 
                                    editada = Primas2_menos_10$Primas, 
                                    porcentaje= (Primas2_menos_10$Primas / Primas$Primas) * 100)

#Imprime el porcentaje promedio que representan las nuevas primas de las originales
print(sum(Verifica2_90_porciento$porcentaje)/nrow(Verifica2_90_porciento))

## [1] 90.01209

#Primas para empleados, Hombre o Mujer y su respectiva edad 
Primas_unicas_0.05 <- Calcula_prima_individuales(base_unicas,tablas_supen,5000000,1000000,300000,0.05)
Primas_unicas_0.05 <- Primas_unicas_0.05%>%
                  mutate(Sexo = if_else(Sexo == 1,'Hombre', 'Mujer')) %>%
                  select(-c(`Empleado`,`anualidad`,`beneficios`))

tabla_para_graficar_distinta_tasa <- data.frame( sexo = Primas_unicas$Sexo,
                                                 edad = Primas_unicas$Edad,
                                                 primas_normales = Primas_unicas$Primas,
                                                 primas_tasa_aumentada = Primas_unicas_0.05$Primas)

tabla_distinta_tasa_hombres <- tabla_para_graficar_distinta_tasa[tabla_para_graficar_distinta_tasa$sexo == "Hombre", ]
tabla_distinta_tasa_mujeres <- tabla_para_graficar_distinta_tasa[tabla_para_graficar_distinta_tasa$sexo == "Mujer", ]